home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / lang / FPL_v147.lha / fpl / src / hash.c < prev    next >
C/C++ Source or Header  |  1996-08-06  |  33KB  |  1,204 lines
  1. /******************************************************************************
  2.  *                   FREXX PROGRAMMING LANGUAGE                  *
  3.  ******************************************************************************
  4.  
  5.  hash.c
  6.  
  7.  Functions for FPL hash tables and sorting!
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #include <dos.h>
  44. #else
  45. #include <stdio.h>
  46. #ifdef SUNOS
  47. #include <varargs.h>
  48. #else
  49. #include <stdarg.h>
  50. #endif
  51. #endif
  52. #include "script.h"
  53. #include "debug.h"
  54. #include <limits.h>
  55.  
  56. #ifdef DEBUG
  57. #include <stdio.h>
  58. #endif
  59.  
  60. static ReturnCode INLINE InitHash(struct Data *);
  61. static unsigned long INLINE Gethash(uchar *);
  62. static void * INLINE Init(struct Data *, long ASM (*)(AREG(0) void *), unsigned long *);
  63. static ReturnCode REGARGS SetTags(struct Data *, unsigned long *);
  64. static ReturnCode INLINE Hijack(struct Data *, struct Identifier *);
  65. static ReturnCode REGARGS AddIdentifier(struct Data *, struct Identifier *);
  66.  
  67.  
  68. ReturnCode REGARGS
  69.     RenameIdentifier(struct Data *scr,
  70.              struct Identifier *ident, /* existing identifier */
  71.              uchar *newname)           /* new name */
  72. {
  73.     ReturnCode ret;
  74.     struct Identifier *nident;
  75.     ret = GetIdentifier(scr, newname, &nident);
  76.     if(ret != FPLERR_IDENTIFIER_NOT_FOUND) {
  77.       return FPLERR_IDENTIFIER_USED; /* !!! */
  78.     }
  79.  
  80.     if(ident->flags&FPL_KEYWORD ||
  81.        !(ident->flags&(FPL_EXTERNAL_FUNCTION|FPL_EXPORT_SYMBOL))) {
  82.       /*
  83.        * Nonononono... we have to draw the limit somewhere!!!
  84.        */
  85.       return FPLERR_IDENTIFIER_USED;
  86.     }
  87.     /*
  88.      * Let's take the old one out of its chains!
  89.      */
  90.     if(ident->prev) {
  91.       /* If there is a previous member */
  92.       ident->prev->next=ident->next;
  93.     }
  94.     else {
  95.       /* if this was the first in the list */
  96.       scr->hash[ident->hash%scr->hash_size]=ident->next;
  97.     }
  98.     if(ident->next) {
  99.       ident->next->prev=ident->prev;
  100.     }
  101.     if(ident->flags&(FPL_INTERNAL_FUNCTION|FPL_EXTERNAL_FUNCTION)) {
  102.       if(ident->flags&FPL_DEALLOC_NAME_ANYWAY) {
  103.         /* Oh well, this has already been renamed once! */
  104.         FREE_KIND(ident->name);
  105.       }
  106.       else
  107.         ident->flags |= FPL_DEALLOC_NAME_ANYWAY;
  108.         /* this have to be known since this kind of functions regularly uses
  109.            names in the user-area which never get freed by us! */
  110.     }
  111.     else {
  112.       FREE_KIND(ident->name);
  113.     }
  114.     STRDUPA(ident->name, newname);
  115.     CALL( AddIdentifier(scr, ident));
  116.     return ret;
  117. }
  118.  
  119. #ifndef AMIGA /* if not using SAS/C on Amiga */
  120.  
  121. #ifdef VARARG_FUNCTIONS
  122. long fplAddFunctionTags(void *anchor, uchar *name, long ID, uchar rtrn,
  123.                         uchar *format, ...)
  124. {
  125.   va_list tags;
  126.   long ret;
  127. #ifdef SUNOS
  128.   va_start(tags); /* get parameter list */
  129. #else
  130.   va_start(tags, format); /* get parameter list */
  131. #endif
  132.   ret = fplAddFunction(anchor, name, ID, rtrn, format, (unsigned long *)tags);
  133.   va_end(tags);
  134.   return ret;
  135. }
  136. #else
  137. long fplAddFunctionTags(void *anchor, uchar *name, long ID, uchar rtrn,
  138.                         uchar *format, unsigned long tags, ...)
  139. {
  140.   return(fplAddFunction(anchor, name, ID, rtrn, format, &tags));
  141. }
  142. #endif
  143.  
  144. #endif
  145.  
  146. /**********************************************************************
  147.  *
  148.  * int fplAddFunction();
  149.  *
  150.  * User frontend to AddIdentifier().
  151.  *
  152.  *****/
  153.  
  154. ReturnCode PREFIX
  155.   fplAddFunction(AREG(0) struct Data *scr,      /* pointer to struct Data */
  156.          AREG(1) uchar *name,     /* name of function */
  157.          DREG(0) long ID,     /* function ID */
  158.          DREG(1) uchar rtrn,      /* return type */
  159.          AREG(2) uchar *format,   /* format string */
  160.          AREG(3) unsigned long *tags) /* taglist pointer */
  161. {
  162.   ReturnCode ret;
  163.   struct Identifier *ident;
  164. #ifdef DEBUGMAIL
  165.   DebugMail(scr, MAIL_FUNCTION, 500, "fplAddFunction");
  166. #endif
  167.   if(!scr)
  168.     return(FPLERR_ILLEGAL_ANCHOR);
  169.  
  170.   ident=MALLOCA(sizeof(struct Identifier));
  171.   if(!ident)
  172.     return(FPLERR_OUT_OF_MEMORY);
  173.  
  174.   memset(&ident->data.external, 0, sizeof(struct ExternalFunction));
  175.   while(tags && *tags) {
  176.     switch(*tags++) {
  177.     case FPLTAG_USERDATA:
  178.       ident->data.external.data=(void *)*tags;
  179.       break;
  180.     case FPLTAG_FUNCTION:
  181.       ident->data.external.func=(long (*)(void *))*tags;
  182.       break;
  183.     }
  184.     tags++; /* next! */
  185.   }
  186.  
  187.   ident->name = name;
  188.   ident->data.external.ID = ID;
  189.   ident->data.external.ret = rtrn;
  190.   ident->data.external.format = format;
  191.   ident->flags = FPL_EXTERNAL_FUNCTION|FPL_GLOBAL_SYMBOL|FPL_EXPORT_SYMBOL;
  192.   ident->file = "<user>"; /* User added! */
  193.   ident->func = NULL; /* everywhere! */
  194.   ident->level = 0;
  195.  
  196.   CALL(AddIdentifier(scr, ident));
  197.   return(FPL_OK);
  198. }
  199.  
  200. /**********************************************************************
  201.  *
  202.  * int fplDelFunction();
  203.  *
  204.  * User frontend to DelIdentifier().
  205.  *
  206.  ******/
  207.  
  208. ReturnCode PREFIX fplDelFunction(AREG(0) struct Data *scr,
  209.                  AREG(1) uchar *name)
  210. {
  211.   ReturnCode ret;
  212. #ifdef DEBUGMAIL
  213.   DebugMail(scr, MAIL_FUNCTION, 500, "fplDelFunction");
  214. #endif
  215.   if(!scr)
  216.     return(FPLERR_ILLEGAL_ANCHOR);
  217.   CALL(DelIdentifier(scr, name, NULL));
  218.   return(FPL_OK);
  219. }
  220.  
  221.  
  222. /**********************************************************************
  223.  *
  224.  * int AddToList();
  225.  *
  226.  * Add the ident pointer the Local list.
  227.  *
  228.  *********************************************************************/
  229. ReturnCode REGARGS
  230. AddToList(struct Data *scr, /* pointer to struct Data */
  231.           struct Identifier *ident,/* identifier struct pointer */
  232.           struct Local **local)
  233. {
  234.   struct Local *temp;
  235.   GETMEM(temp, sizeof(struct Local));  
  236.   temp->next=*local;
  237.   temp->ident=ident;
  238.   *local=temp;
  239.   return FPL_OK;
  240. }
  241.  
  242. /**********************************************************************
  243.  *
  244.  * int AddVar();
  245.  *
  246.  * Frontend to the AddIdentifier function.
  247.  *
  248.  * This routine adds a member to the linked list of local variable names.
  249.  * That list exists to enable easy and fast removal of local variables
  250.  * when leaving a block within which local variables has been declared!
  251.  *
  252.  * Make sure that the name member data is static as long we need this list
  253.  * cause this routine doesn't copy that name, simply points to it!
  254.  *
  255.  *****/
  256.  
  257.  
  258. ReturnCode REGARGS
  259. AddVar(struct Data *scr, /* pointer to struct Data */
  260.        struct Identifier *ident,/* identifier struct pointer */
  261.        struct Local **local)
  262. {
  263.   ReturnCode ret;
  264.   if(ret=AddIdentifier(scr, ident))
  265.     ;
  266.   else {
  267.     ret = AddToList(scr, ident, local);
  268.   }
  269.   return ret;
  270. }
  271.  
  272. /**********************************************************************
  273.  *
  274.  * AddLevel();
  275.  *
  276.  * This function adds a NULL-name in the local symbol list to visualize
  277.  * the beginning of a new variable level!
  278.  *
  279.  *******/
  280.  
  281. ReturnCode REGARGS
  282. AddLevel(struct Data *scr)
  283. {
  284.   struct Local *temp;
  285.   GETMEM(temp, sizeof(struct Local));  
  286.   temp->next=scr->locals;
  287.   temp->ident=NULL;
  288.   scr->locals=temp;
  289.   return(FPL_OK);
  290. }
  291.  
  292.  
  293. /**********************************************************************
  294.  *
  295.  * int DelLocalVar()
  296.  *
  297.  * This routine deletes all members to the linked list of local variable
  298.  * names. Call this routine every time you leave a local level. Deletes
  299.  * all variables and the following NULL name!
  300.  *
  301.  *****/
  302.  
  303. ReturnCode REGARGS
  304. DelLocalVar(struct Data *scr,
  305.             struct Local **local)
  306. {
  307.   /* This removes only all listed symbols! */
  308.   struct Identifier *ident;
  309.   while(*local) {
  310.     struct Local *temp=(*local)->next;
  311.     ident=(*local)->ident;
  312.     FREE(*local);
  313.     *local=temp;
  314.     if(ident)
  315.       DelIdentifier(scr, NULL, ident); /* delete it for real */
  316.     else
  317.       break;
  318.   }
  319.   return(FPL_OK);
  320. }
  321.  
  322.  
  323. /**********************************************************************
  324.  *
  325.  * int AddIdentifier()
  326.  *
  327.  * This function adds the function to the hash table according to all
  328.  * parameters.
  329.  *
  330.  * If the hash member of the Data structure is NULL, the hash table
  331.  * will be inited. No not init the hash list if you don't have to cause
  332.  * that sure is a peep hole in the performance...
  333.  *
  334.  *******/
  335.  
  336. ReturnCode REGARGS static
  337. AddIdentifier(struct Data *scr,
  338.               struct Identifier *ident)
  339. {
  340.   unsigned long hash;       /* hash number of the identifier */
  341.   struct Identifier **add;  /* where to store the pointer to this identifier */
  342.   struct Identifier *prev=NULL; /* pointer to previous hash structure */
  343.   struct Identifier *next;  /* pointer to next hash structure */
  344.   ReturnCode ret;
  345.   hash=Gethash(ident->name);
  346.   
  347.   add=(struct Identifier **)&scr->hash[hash % scr->hash_size];
  348.   while(*add) {
  349.     if((*add)->hash==hash) {
  350.       /* they were identical */
  351.       if(ident->flags&FPL_FUNCTION &&
  352.      !strcmp((*add)->name, ident->name) &&
  353. /*
  354.   PREV STOOPID WAY:
  355.      (!ident->file || !strcmp(ident->file, (*add)->file))) { */
  356.  
  357.      (ident->flags&FPL_EXPORT_SYMBOL || !strcmp(ident->file, (*add)->file))) {
  358.     /* if it's already there, fail!!! */
  359.     return FPLERR_IDENTIFIER_USED;
  360.       } else
  361.     /* add it here! */
  362.     break; 
  363.     } else if((*add)->hash>hash) {
  364.       /* continue search for a place to insert */
  365.       /* 'add' now points to the pointer */
  366.       prev=(*add);
  367.       add=(struct Identifier **)&((*add)->next);
  368.     } else {
  369.       /* insert it here! */
  370.       prev=(*add)->prev;
  371.       break;
  372.     }
  373.   }
  374.  
  375.   next=(*add);
  376.   *add=ident;
  377.   (*add)->hash=hash;
  378.   (*add)->prev=prev;
  379.   (*add)->next=next;
  380.   if(next)
  381.     next->prev=ident;
  382.   return(FPL_OK);
  383. }
  384.  
  385. /**********************************************************************
  386.  *
  387.  * int GetIdentifier();
  388.  *
  389.  * Sets the pointer to the Identifier structure to which the name
  390.  * fits, in the third argument.
  391.  *
  392.  *****/
  393.  
  394. #ifdef DEBUG
  395. int hashed=0;
  396. int max_hashed=0;
  397. #endif
  398.  
  399. ReturnCode REGARGS
  400. GetIdentifier(struct Data *scr,
  401.               uchar *name,
  402.           struct Identifier **ident)
  403. {
  404.   ReturnCode ret;
  405.   struct Identifier *get;
  406.   unsigned long hash=Gethash(name);
  407.   get=scr->hash[hash%scr->hash_size];
  408. #ifdef DEBUG
  409.   hashed=0;
  410. #endif
  411.  
  412.   while(get) {
  413.     if(
  414.  
  415.        (get->hash==hash) && 
  416.        /* identical hash value! */
  417.  
  418.        !strcmp(get->name, name) &&
  419.        /* identical name! */
  420.  
  421.        (get->flags&(FPL_GLOBAL_SYMBOL|FPL_EXPORT_SYMBOL) ||
  422.         (get->func==scr->func && get->level<=scr->varlevel)) &&
  423.        /* If not global, declared under the *same* function, in this or
  424.       a lower level! */
  425.  
  426.        (get->flags&FPL_EXPORT_SYMBOL || !strcmp(get->file, scr->prog->name))
  427.        /* If not cross-file, the same file! */
  428.  
  429.        ) {
  430.  
  431.       /* this is it! */
  432.       *ident=get;
  433. #ifdef DEBUG
  434.       if(hashed>max_hashed)
  435.     max_hashed=hashed;
  436. #endif
  437.       if(get->flags&FPL_EXTERNAL_VARIABLE) {
  438.         CALL(Hijack(scr, get));
  439.       }
  440.       else if(scr->flags&FPLDATA_ISOLATE && get->flags&FPL_EXPORT_SYMBOL) {
  441.         /*
  442.          * Isolated and exported symbol... really?
  443.          */
  444.         if((get->flags&(FPL_FUNCTION|FPL_KEYWORD) == FPL_INSIDE_FUNCTION) ||
  445.            get->flags&FPL_VARIABLE) {
  446.           /*
  447.            * Nope, this symbol shouldn't get returned!
  448.            */
  449.           break;
  450.         }
  451.       }
  452. #ifdef DEBUGMAIL
  453.       DebugMail(scr, MAIL_IDENTIFIER_ACCESS, 0, get);
  454. #endif
  455.       return FPL_OK;
  456.     } else if(get->hash<hash)
  457.       /* we've been searching through all possible alternatives! */
  458.       break;
  459. #ifdef DEBUG
  460.     hashed++;
  461. #endif
  462.     get=get->next;
  463.   }
  464.   *ident=NULL;
  465.   return FPLERR_IDENTIFIER_NOT_FOUND;
  466. }
  467.  
  468.  
  469. #ifndef AMIGA /* if not using SAS/C on Amiga */
  470.  
  471. #ifdef VARARG_FUNCTIONS
  472. long fplAddVariableTags(void *anchor, uchar *name, long ID, uchar type,
  473.                         void *defvalue, ...)
  474. {
  475.   va_list tags;
  476.   long ret;
  477. #ifdef SUNOS
  478.   va_start(tags); /* get parameter list */
  479. #else
  480.   va_start(tags, defvalue); /* get parameter list */
  481. #endif
  482.   ret = fplAddVariable(anchor, name, ID, type, defvalue, (unsigned long *)tags);
  483.   va_end(tags);
  484.   return ret;
  485. }
  486. #else
  487. long fplAddVariableTags(void *anchor, uchar *name, long ID, uchar type,
  488.                         void *defvalue, unsigned long tags, ...)
  489. {
  490.   return fplAddVariable(anchor, name, ID, type, defvalue, &tags);
  491. }
  492. #endif
  493.  
  494. #endif
  495.  
  496. /**********************************************************************
  497.  *
  498.  * int fplAddVariable();
  499.  *
  500.  * User frontend to AddIdentifier(). New in version 10!
  501.  *
  502.  *****/
  503.  
  504. ReturnCode PREFIX
  505.   fplAddVariable(AREG(0) struct Data *scr, /* pointer to struct Data */
  506.          AREG(1) uchar *name,       /* name of variable */
  507.          DREG(0) long ID,       /* variable ID */
  508.          DREG(1) uchar type,        /* variable type */
  509.                  AREG(2) void *defvalue,   /* default value */
  510.          AREG(3) unsigned long *tags) /* taglist pointer */
  511. {
  512.   ReturnCode ret;
  513.   struct Identifier *ident;
  514. #ifdef DEBUGMAIL
  515.   DebugMail(scr, MAIL_FUNCTION, 500, "fplAddVariable");
  516. #endif
  517.   if(!scr)
  518.     return(FPLERR_ILLEGAL_ANCHOR);
  519.  
  520.   GETMEMA(ident, sizeof(struct Identifier));
  521.  
  522.   memset(&ident->data.variable, 0, sizeof(struct fplVariable));
  523.  
  524.   ident->name = name;
  525.   ident->data.variable.ID = ID;
  526.   ident->flags = FPL_EXTERNAL_VARIABLE|FPL_GLOBAL_SYMBOL|FPL_EXPORT_SYMBOL|
  527.     (type == FPL_STRARG? FPL_STRING_VARIABLE:FPL_INT_VARIABLE)|
  528.       FPL_READONLY;
  529.   if(type == FPL_INTARG) {
  530.     GETMEM(ident->data.variable.var.val32, sizeof(long));
  531.     ident->data.variable.var.val32[0] = (long) defvalue;
  532.   }
  533.   else
  534.     if(defvalue) {
  535.       register long len = (long)strlen((uchar *)defvalue);
  536.       if(len) {
  537.         GETMEM(ident->data.variable.var.str, sizeof(struct fplStr *));
  538.         GETMEM(ident->data.variable.var.str[0], len + sizeof(struct fplStr));
  539.         ident->data.variable.var.str[0]->len = len;
  540.         ident->data.variable.var.str[0]->alloc = len;
  541.         memcpy(ident->data.variable.var.str[0]->string, defvalue,
  542.                len);
  543.         ident->data.variable.var.str[0]->string[len] = '\0'; /* Z-terminate */
  544.       }
  545.     }
  546.   ident->file = "<user>"; /* Used added! */
  547.   ident->func = NULL; /* everywhere! */
  548.   ident->level = 0;
  549.  
  550.   CALL(AddIdentifier(scr, ident));
  551.   return(FPL_OK);
  552. }
  553.  
  554. /*************************************************************************
  555.  *
  556.  * Hijack();
  557.  *
  558.  * This function gets called whenever an external variable has been selected
  559.  * by GetIdentifier().
  560.  *
  561.  ******/
  562.  
  563. static ReturnCode INLINE Hijack(struct Data *scr, struct Identifier *ident)
  564. {
  565.   struct fplArgument pass;
  566.   struct fplMsg *msg;
  567.   ReturnCode ret;
  568.  
  569.   memset(&pass, 0, sizeof(struct fplArgument));
  570.   pass.argc=0;
  571.   pass.name=ident->name;
  572.   pass.ID=ident->data.variable.ID;
  573.   pass.key=scr;
  574.  
  575.   pass.variable = (void *)
  576.     (ident->flags&FPL_STRING_VARIABLE?
  577.      (ident->data.variable.var.str &&ident->data.variable.var.str[0]?
  578.       ident->data.variable.var.str[0]->string:""):
  579.      (void *)ident->data.variable.var.val32[0]);
  580.  
  581.   CALL(InterfaceCall(scr, &pass, scr->function));
  582.   if(ident->flags&FPL_INT_VARIABLE) {
  583.     /*
  584.      * Integer variable!
  585.      */
  586.     CALL(GetMessage(scr, FPLMSG_RETURN, &msg));
  587.     if(msg && msg->flags&FPLMSG_FLG_INT) {
  588.       ident->data.variable.var.val32[0]=(long)msg->message[0];
  589.       CALL(DeleteMessage(scr, msg));
  590.     }
  591.   } else {
  592.     /*
  593.      * String variable!
  594.      */
  595.     CALL(GetMessage(scr, FPLMSG_RETURN, &msg));
  596.     if(msg && msg->flags&FPLMSG_FLG_STRING) {
  597.       if(!ident->data.variable.var.str) {
  598.     GETMEMA(ident->data.variable.var.str, sizeof(struct fplStr *));
  599.       }
  600.       else if(ident->data.variable.var.str[0]) {
  601.     FREEA(ident->data.variable.var.str[0]);
  602.       }
  603.       ident->data.variable.var.str[0]=(struct fplStr *)msg->message[0];
  604.       /*
  605.        * Make the string to be static always!
  606.        */
  607.       SwapMem(scr, ident->data.variable.var.str[0], MALLOC_STATIC);
  608.       DeleteMessage(scr, msg);
  609.     }
  610.   }
  611.   return(FPL_OK);
  612. }
  613.  
  614. /**********************************************************************
  615.  *
  616.  * int InitHash()
  617.  *
  618.  * Initialize the hash table. Simple and quick!
  619.  *
  620.  *****/
  621.  
  622. struct ShitData {
  623.   uchar *name;
  624.   long ID;
  625.   uchar ret;
  626.   uchar *format;
  627. };
  628.  
  629. struct MoreShitData {
  630.   uchar *name;
  631.   long ID;
  632.   long flags;
  633. };
  634.  
  635. static ReturnCode INLINE InitHash(struct Data *scr)
  636. {
  637.   ReturnCode ret;
  638.   static struct ShitData internal_functions[]={
  639.     {"abs",        FNC_ABS,    'I', "I"},
  640.     {"atoi",        FNC_ATOI,    'I', "S"},
  641.     {"closelib",    FNC_CLOSELIB,    'I', "S"},  /* amiga only */
  642.     {"debug",        FNC_DEBUG,    'I', "i"},
  643.     {"eval",        FNC_EVAL,    'I', "S"},
  644.     {"exists",          FNC_EXISTS,     'I', "Si"},
  645.     {"interpret",    FNC_INTERPRET,    'I', "S"},
  646.     {"itoa",        FNC_ITOA,    'S', "I"},
  647.     {"itoc",        FNC_ITOC,    'S', "I"},
  648.     {"joinstr",        FNC_JOINSTR,    'S', "s>"},
  649.     {"ltostr",        FNC_LTOSTR,    'S', "Ii"},
  650.     {"openlib",        FNC_OPENLIB,    'I', "SI"}, /* amiga only */
  651.     {"rename",        FNC_RENAME,     'I', "SS"},
  652.     {"sprintf",        FNC_SPRINTF,    'S', "Sa>"},
  653.     {"sscanf",          FNC_SSCANF,     'I', "SSa>"},
  654.     {"strcmp",        FNC_STRCMP,    'I', "SS"},
  655.     {"stricmp",        FNC_STRICMP,    'I', "SS"},
  656.     {"strlen",        FNC_STRLEN,    'I', "S"},
  657.     {"strncmp",        FNC_STRNCMP,    'I', "SSI"},
  658.     {"strnicmp",    FNC_STRNICMP,    'I', "SSI"},
  659.     {"strstr",        FNC_STRSTR,    'I', "SSi"},
  660.     {"stristr",        FNC_STRISTR,    'I', "SSi"},
  661.     {"strtol",        FNC_STRTOL,    'I', "Si"},
  662.     {"substr",        FNC_SUBSTR,    'S', "SII"},
  663.   };
  664.  
  665.   /* FPL keywords. "else" is not included (treated special). Is is
  666.      defines as KEYWORD_ELSE */
  667.  
  668.   static struct MoreShitData keywords[]={
  669.     {"auto",    CMD_AUTO,    FPL_KEYWORD_DECLARE},
  670.     {"break",    CMD_BREAK,    0},
  671.     {"case",    CMD_CASE,    0},
  672.     {"char",    CMD_INT,    FPL_KEYWORD_DECLARE|FPL_CHAR_VARIABLE},
  673.     {"const",    CMD_CONST,    FPL_KEYWORD_DECLARE},
  674.     {"continue", CMD_CONTINUE,    0},
  675.     {"default",    CMD_DEFAULT,    0},
  676.     {"do",    CMD_DO,        0},
  677.     {"double",    CMD_DOUBLE,    FPL_IGNORE},
  678.     {"enum",    CMD_ENUM,    FPL_IGNORE},
  679.     {"exit",    CMD_EXIT,    0},
  680.     {"export",    CMD_EXPORT,    FPL_KEYWORD_DECLARE},
  681.     {"float",   CMD_FLOAT,    FPL_IGNORE},
  682.     {"for",    CMD_FOR,    0},
  683.     {"if",    CMD_IF,        0},
  684.     {"int",    CMD_INT,    FPL_KEYWORD_DECLARE},
  685.     {"long",    CMD_INT,    FPL_KEYWORD_DECLARE},
  686.     {"register",CMD_REGISTER,    FPL_KEYWORD_DECLARE},
  687.     {"resize",    CMD_RESIZE,    0},
  688.     {"return",    CMD_RETURN,    0},
  689.     {"short",    CMD_INT,    FPL_KEYWORD_DECLARE|FPL_SHORT_VARIABLE},
  690.     {"signed",    CMD_SIGNED,    FPL_KEYWORD_DECLARE|FPL_IGNORE},
  691.     {"static",  CMD_STATIC,    FPL_KEYWORD_DECLARE},
  692.     {"string",    CMD_STRING,    FPL_KEYWORD_DECLARE},
  693.     {"struct",  CMD_STRUCT,    FPL_IGNORE},
  694.     {"switch",    CMD_SWITCH,    0},
  695.     {"typedef",    CMD_TYPEDEF,    0},
  696.     {"union",    CMD_UNION,    FPL_IGNORE},
  697.     {"unsigned",CMD_UNSIGNED,    FPL_KEYWORD_DECLARE|FPL_IGNORE},
  698.     {"void",    CMD_VOID,    FPL_KEYWORD_DECLARE},
  699.     {"volatile",CMD_VOLATILE,    FPL_KEYWORD_DECLARE|FPL_IGNORE},
  700.     {"while",    CMD_WHILE,    0},
  701.   };
  702.   long i;
  703.   struct Identifier *ident;
  704.   GETMEMA(scr->hash, sizeof(struct Identifier *)* scr->hash_size);
  705.  
  706.   memset((void *)scr->hash, 0, sizeof(struct Identifier *)*scr->hash_size);
  707.   /*
  708.    * The hash table initialization gives us a brilliant chance to bring up
  709.    * the execution speed even more by inserting the few internal functions
  710.    * into this same table. The functions will then act *EXACTLY* the same
  711.    * and we can shorten the code and much easier write internal functions
  712.    * that return strings...
  713.    */
  714.  
  715.   for(i=0; i<sizeof(internal_functions)/sizeof(struct ShitData);i++) {
  716.     GETMEMA(ident, sizeof(struct Identifier));
  717.     ident->name=internal_functions[i].name;
  718.     ident->data.external.ID=internal_functions[i].ID;
  719.     ident->data.external.ret=internal_functions[i].ret;
  720.     ident->data.external.format=internal_functions[i].format;
  721.     ident->flags=FPL_INTERNAL_FUNCTION|FPL_EXPORT_SYMBOL;
  722.     ident->level=0;
  723.     ident->func=NULL; /* all functions */
  724.     ident->file= "<FPL>"; /* internal */
  725.     ret=AddIdentifier(scr, ident);
  726.     if(ret)
  727.       break;
  728.   }
  729.   for(i=0; i<sizeof(keywords)/sizeof(struct MoreShitData);i++) {
  730.     GETMEMA(ident, sizeof(struct Identifier));
  731.     ident->name=keywords[i].name;
  732.     ident->data.external.ID=keywords[i].ID;  /* dirty enum work! */
  733.     ident->flags=FPL_EXPORT_SYMBOL|FPL_KEYWORD|keywords[i].flags;
  734.     ident->level=0;
  735.     ident->func=NULL;  /* all functions */
  736.     ident->file= "<FPL>";  /* internal */
  737.     ret=AddIdentifier(scr, ident);
  738.     if(ret)
  739.       break;
  740.   }
  741.   return(ret);
  742. }
  743.  
  744. /**********************************************************************
  745.  *
  746.  * int Gethash();
  747.  *
  748.  * Return the hash number for the name received as argument.
  749.  *
  750.  *****/
  751.  
  752. static unsigned long INLINE Gethash(uchar *name)
  753. {
  754.   unsigned long hash=0;
  755.   while(*name)
  756.     hash=(hash<<1)+*name+++(hash&(1<<31)?-2000000000:0);
  757.   return(hash);
  758. }
  759.  
  760. /**********************************************************************
  761.  *
  762.  * void Free();
  763.  *
  764.  * This function frees the resources used by this FPL session.
  765.  *
  766.  ***********/
  767.  
  768. void PREFIX fplFree(AREG(0) struct Data *scr)
  769. {
  770.   struct Data onstack;
  771.   long retval;
  772. #ifdef DEBUGMAIL
  773.   DebugMail(scr, MAIL_FUNCTION, 500, "fplFree");
  774. #endif
  775.   onstack=*scr; /* copy the entire struct */
  776.   scr=&onstack; /* use the `stack-struct' */
  777.   DelProgram(scr, NULL); /* remove all programs from memory, some might be
  778.                 Lock()'ed! */
  779. #ifdef AMIGA /* only amiga supports funclibs! */
  780.   CloseLib(scr, NULL, TRUE, &retval); /* force close of all funclibs */
  781. #endif
  782.   FREEALL();
  783.   FREEALLA();
  784. }
  785.  
  786. /**********************************************************************
  787.  *
  788.  * int DelIdentifier()
  789.  *
  790.  * Delete an identifier from the hash table. Specify 'name' or 'ident'.
  791.  *
  792.  ******/
  793.  
  794. ReturnCode REGARGS
  795. DelIdentifier(struct Data *scr,
  796.               uchar *name, /* only needed if 'ident' is NULL! */
  797.           struct Identifier *ident)
  798. {
  799.   ReturnCode ret=FPL_OK;
  800.   long i;
  801.   struct fplVariable *var;
  802.  
  803.   if(!ident) {
  804.     /* Get the structure pointer */
  805.     CALL(GetIdentifier(scr, name, &ident));
  806.   }
  807.  
  808.   if(!(ident->flags & FPL_COMPILER_ADDED)) {
  809.     /*
  810.      * Symbols added by compiled programs are not added to the hash
  811.      * list!
  812.      */
  813.     
  814.     /* Link the previous member in the list to the next member */
  815.     if(ident->prev)
  816.       /* If there is a previous member */
  817.       ident->prev->next=ident->next;
  818.     else
  819.       /* if this was the first in the list */
  820.       scr->hash[ident->hash%scr->hash_size]=ident->next;
  821.   
  822.     if(ident->next)
  823.       ident->next->prev=ident->prev;
  824.   }
  825.  
  826.   /*
  827.    * If it is any kind of funtion, all the data the pointers points to
  828.    * should (in the specs) be static and should therefore *NOT* be
  829.    * freed here!
  830.    *
  831.    * Notice that even internal functions are possible to remove here...
  832.    */
  833.  
  834.   if(ident->flags & FPL_VARIABLE) {
  835.     /*
  836.      * It's a variable identifier. Free some members:
  837.      */
  838.     
  839.     var=&ident->data.variable;
  840.     
  841.     if(ident->flags & FPL_REFERENCE) {
  842.       /* only keep a reference pointer! */
  843.     }
  844.     else {
  845.       if(ident->flags & FPL_STRING_VARIABLE) {
  846.     /* it's a string array! */
  847.     for(i=0; i<var->size; i++)
  848.       if(var->var.str[i]) {
  849.         FREE_KIND(var->var.str[i]);
  850.       }
  851.       }
  852.       if(var->num)
  853.     FREE_KIND(var->dims);
  854.       FREE_KIND(var->var.val);
  855.     }
  856.   } else if(ident->flags&FPL_INSIDE_FUNCTION &&
  857.             ident->data.inside.format) {
  858.     FREE_KIND(ident->data.inside.format);
  859.   }
  860.   if((ident->flags&FPL_EXTERNAL_FUNCTION)||
  861.      (ident->flags&(FPL_INTERNAL_FUNCTION|FPL_KEYWORD))) {
  862.     /* internal or external function/keyword */
  863.     if(ident->flags&FPL_DEALLOC_NAME_ANYWAY)
  864.       /* this name has been renamed into this! */
  865.       FREE_KIND(ident->name);
  866.     FREEA(ident);
  867.   } else  {
  868.     if(!(ident->flags&FPL_COMPILER_ADDED)) {
  869.       FREE_KIND(ident->name);
  870.     }
  871.     FREE_KIND(ident);
  872.   }
  873.   return(ret);
  874. }
  875.  
  876.  
  877. #ifndef AMIGA /* if not using SAS/C on Amiga */
  878.  
  879. #ifdef VARARG_FUNCTIONS
  880. void *fplInitTags(long (*func)(void *), ...)
  881. {
  882.   va_list tags;
  883.   void *ret;
  884. #ifdef SUNOS
  885.   va_start(tags); /* get parameter list */
  886. #else
  887.   va_start(tags, func); /* get parameter list */
  888. #endif
  889.   ret = fplInit(func, (unsigned long *)tags);
  890.   va_end(tags);
  891.   return ret;
  892. }
  893. #else
  894. void *fplInitTags(long (*func)(void *), unsigned long tags, ...)
  895. {
  896.   return(fplInit(func, (unsigned long *)&tags));
  897. }
  898. #endif
  899.  
  900. #endif
  901.  
  902. /**********************************************************************
  903.  *
  904.  * fplInit();
  905.  *
  906.  * Initialize a lot of FPL internal structures and references. Returns
  907.  * NULL if anything went wrong!
  908.  *
  909.  *******/
  910.  
  911. void * ASM fplInit(AREG(0) long (*function) (void *),
  912.            /* function handler pointer */
  913.            AREG(1) unsigned long *tags) /* taglist */
  914. {
  915.   struct Data point;
  916.   struct Data *scr;
  917.   void *init;
  918.   scr=&point;
  919.  
  920. #ifdef AMIGA
  921.   /* Store all register before loading index register */
  922.   StoreRegisters(scr);
  923.   geta4();
  924. #endif
  925.  
  926.   init=Init(&point, function, tags);
  927.   if(!init)
  928.     FREEALLA();
  929. #ifdef DEBUGMAIL
  930.   DebugMail(scr, MAIL_FUNCTION, 500, "fplInit");
  931. #endif
  932.   return(init);
  933. }
  934.  
  935. static void * INLINE Init(struct Data *scr,    /* stack oriented */
  936.               long ASM (*function) (AREG(0) void *), 
  937.               unsigned long *tags) /* taglist */
  938. {
  939.   ReturnCode ret;
  940.   uchar *buffer;
  941.   struct Data *ptr;
  942. #ifdef AMIGA
  943.   long registers[11];
  944.  
  945.   memcpy(registers, scr->registers, sizeof(long)*11);
  946. #endif
  947.   /* Set default that just might get changed in SetTags(); */
  948.  
  949.   memset(scr, 0, sizeof(struct Data)); /* NULLs everything! */
  950.  
  951.   scr->Alloc=DefaultAlloc;
  952.   scr->Dealloc=DefaultDealloc;;
  953.   scr->hash_size=FPL_HASH_SIZE;
  954.   scr->runs=0;
  955.   InitFree(scr); /* init memory caches */
  956.  
  957. #ifdef AMIGA
  958.  
  959.   memcpy(scr->registers, registers, sizeof(long)*11);
  960.  
  961.   scr->stack_size=FPL_MIN_STACK;
  962.   scr->stack_max=FPL_MAX_STACK;
  963.   scr->stack_limit=FPL_MAX_LIMIT;
  964.   scr->stack_margin=FPLSTACK_MINIMUM;
  965. #endif
  966.  
  967.   SetTags(scr, tags); /* read tags and set proper members */
  968.  
  969.   buffer=(uchar *)MALLOCA(BUF_SIZE);
  970.   if(!buffer)
  971.     /* fail! */
  972.     return(NULL);
  973.  
  974. #ifdef AMIGA
  975. #pragma msg 225 ignore    /* ignore the 225 warnings that occur on the following
  976.                assign! */
  977. #endif
  978.   scr->function=(long ASM (*)(AREG(0) void *))function;
  979.  
  980. #ifdef AMIGA
  981. #pragma msg 225 warning    /* enable the 225 warnings again! */
  982. #endif
  983.  
  984.   scr->buf=buffer;
  985.  
  986. #if defined(AMIGA) && defined(SHARED)
  987.   scr->stack_base=MALLOCA(scr->stack_size);
  988.   if(!scr->stack_base)
  989.     return(NULL);
  990.   scr->intern_stack = (long)scr->stack_base + scr->stack_size;
  991.   Forbid();
  992.   scr->task = FindTask(NULL);  /* get pointer to our task! */
  993.   Permit();
  994. #endif
  995.  
  996.   if(ret=InitHash(scr))
  997.     return(NULL);
  998.  
  999.   ptr=(struct Data *)MALLOCA(sizeof(struct Data));
  1000.   if(ptr)
  1001.     *ptr=*scr; /* copy the entire structure! */
  1002.  
  1003.   return((void *)ptr);
  1004. }
  1005.  
  1006. #ifndef AMIGA /* if not using SAS/C on Amiga */
  1007.  
  1008. #ifdef VARARG_FUNCTIONS
  1009. long fplResetTags(void *anchor, ...)
  1010. {
  1011.   va_list tags;
  1012.   long ret;
  1013. #ifdef SUNOS
  1014.   va_start(tags); /* get parameter list */
  1015. #else
  1016.   va_start(tags, anchor); /* get parameter list */
  1017. #endif
  1018.   ret = fplReset(anchor, (unsigned long *)tags);
  1019.   va_end(tags);
  1020.   return ret;
  1021. }
  1022. #else
  1023. long fplResetTags(void *anchor, unsigned long tags, ...)
  1024. {
  1025.   return(fplReset(anchor, &tags));
  1026. }
  1027. #endif
  1028.  
  1029. #endif
  1030.  
  1031. /**********************************************************************
  1032.  *
  1033.  * fplReset();
  1034.  *
  1035.  * This function is used to change or add tags to FPL. All tags
  1036.  * available for fplFree() is legal. Not changed tags will remain
  1037.  * as they were before this call!
  1038.  *
  1039.  * I had to insert this function since I found out that I wanted to
  1040.  * alter the userdata in my application using FPL, and that was hard
  1041.  * doing so (nice) without this change.
  1042.  * 
  1043.  * Library front end to SetTags();
  1044.  *
  1045.  *****/
  1046.  
  1047. ReturnCode PREFIX fplReset(AREG(0) struct Data *scr,
  1048.                 AREG(1) unsigned long *tags)
  1049. {
  1050. #ifdef DEBUGMAIL
  1051.   DebugMail(scr, MAIL_FUNCTION, 500, "fplReset");
  1052. #endif
  1053.   if(!scr)
  1054.     return FPLERR_ILLEGAL_ANCHOR;
  1055.   return SetTags(scr, tags);
  1056. }
  1057.  
  1058.  
  1059. /**********************************************************************
  1060.  *
  1061.  * SetTags();
  1062.  *
  1063.  * Read the taglist supplied in the second parameter, and set all data
  1064.  * according to those.
  1065.  *
  1066.  *****/
  1067.  
  1068. static ReturnCode REGARGS
  1069. SetTags(struct Data *scr,
  1070.         unsigned long *tags)
  1071. {
  1072.   if(!scr)
  1073.     return(FPLERR_ILLEGAL_ANCHOR);
  1074.  
  1075.   while(tags && *tags) {
  1076.     switch(*tags++) {
  1077. #ifdef AMIGA
  1078. #pragma msg 225 ignore    /* ignore the 225 warnings that occur on the following
  1079.                four assigns! */
  1080. #endif
  1081.     case FPLTAG_INTERVAL:
  1082.       scr->interfunc=(long ASM (*)(AREG(0) void *))*tags;
  1083.       break;
  1084.  
  1085.     case FPLTAG_INTERNAL_ALLOC:
  1086.       scr->Alloc=(void * ASM (*)(DREG(0) long,
  1087.                                  AREG(0) void *))*tags;
  1088.       break;
  1089.     case FPLTAG_INTERNAL_DEALLOC:
  1090.       scr->Dealloc=(void ASM (*)(AREG(1) void *,
  1091.                                  DREG(0) long,
  1092.                                  AREG(0) void *))*tags;
  1093.       break;
  1094. #ifdef AMIGA
  1095. #pragma msg 225 warning /* enable the 225 warning again for correct program
  1096.                checking! */
  1097. #endif
  1098.  
  1099.     case FPLTAG_REREAD_CHANGES:
  1100.       scr->flags = BitToggle(scr->flags, FPLDATA_REREAD_CHANGES, *tags);
  1101.       break;
  1102.  
  1103.     case FPLTAG_FLUSH_NOT_IN_USE:
  1104.       scr->flags = BitToggle(scr->flags, FPLDATA_FLUSH_NOT_IN_USE, *tags);
  1105.       break;
  1106.  
  1107.     case FPLTAG_KIDNAP_CACHED:
  1108.       scr->flags = BitToggle(scr->flags, FPLDATA_KIDNAP_CACHED, *tags);
  1109.       break;
  1110.  
  1111.     case FPLTAG_PREVENT_RUNNING_SAME:
  1112.       scr->flags = BitToggle(scr->flags, FPLDATA_PREVENT_RUNNING_SAME, *tags);
  1113.       break;
  1114.  
  1115.     case FPLTAG_AUTOCOMPILE:
  1116.       scr->flags = BitToggle(scr->flags, FPLDATA_AUTOCOMPILE, *tags);
  1117.       break;
  1118.  
  1119.     case FPLTAG_AUTORUN:
  1120.       scr->flags = BitToggle(scr->flags, FPLDATA_AUTORUN, *tags);
  1121.       break;
  1122.       
  1123.     case FPLTAG_HASH_TABLE_SIZE:
  1124.       if(*tags>FPL_MIN_HASH)
  1125.     scr->hash_size=*tags;
  1126.       break;
  1127.  
  1128.     case FPLTAG_USERDATA:
  1129.       scr->userdata=(void *)*tags;
  1130.       break;
  1131.  
  1132.     case FPLTAG_ALLFUNCTIONS:
  1133.       scr->flags = BitToggle(scr->flags, FPLDATA_ALLFUNCTIONS, *tags);
  1134.       break;
  1135.  
  1136.     case FPLTAG_NESTED_COMMENTS:
  1137.       scr->flags = BitToggle(scr->flags, FPLDATA_NESTED_COMMENTS, *tags);
  1138.       break;
  1139.  
  1140.     case FPLTAG_CACHEALLFILES:
  1141.       if(*tags) {
  1142.     scr->flags|=FPLDATA_CACHEALLFILES;
  1143.     if(*tags == FPLCACHE_EXPORTS)
  1144.       scr->flags|=FPLDATA_CACHEEXPORTS;
  1145.       } else
  1146.     scr->flags &= ~(FPLDATA_CACHEALLFILES|FPLDATA_CACHEEXPORTS);
  1147.       break;
  1148.  
  1149. #ifdef AMIGA
  1150.     case FPLTAG_STACK:
  1151.       /* Only change stack if the required size is large enough! */
  1152.       if(*tags>FPL_MIN_STACK)
  1153.     scr->stack_size=(long)*tags;
  1154.       break;
  1155.  
  1156.     case FPLTAG_MAXSTACK:
  1157.       /* Only change this if the required size is large enough! */
  1158.       if(*tags>FPL_MIN_STACK)
  1159.     scr->stack_max=(long)*tags;
  1160.       break;
  1161.  
  1162.     case FPLTAG_STACKLIMIT:
  1163.       /* Only change this if the required size is large enough! */
  1164.       if(*tags>FPL_MIN_STACK)
  1165.     scr->stack_limit=(long)*tags;      
  1166.       break;
  1167.  
  1168.     case FPLTAG_MINSTACK:
  1169.       /* Only change this if the required size is larger than default! */
  1170.       if(*tags>FPLSTACK_MINIMUM)
  1171.     scr->stack_margin=*tags;
  1172.       break;
  1173. #endif
  1174.  
  1175.     case FPLTAG_IDENTITY:
  1176.       /* new from version 9: Host process identifier! */
  1177.       scr->identifier = (uchar *)(*tags);
  1178.       break;
  1179.       
  1180.     case FPLTAG_DEBUG:
  1181.       scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_GLOBAL, *tags);
  1182.       break;
  1183.       
  1184.     case FPLTAG_ERROR_BUFFER:
  1185.       scr->error = (uchar *)(*tags);
  1186.       break;
  1187.  
  1188.     }
  1189.     tags++; /* next! */
  1190.   }
  1191.   return(FPL_OK);
  1192. }
  1193.  
  1194. long REGARGS
  1195. BitToggle(long original, /* Original 32 bits */
  1196.       long bit,      /* alternate bit pattern */
  1197.       long OnOff)    /* Or/And boolean, TRUE==OR, FALSE==AND */
  1198. {
  1199.   if(OnOff)
  1200.     return ( original | bit );
  1201.   else
  1202.     return ( original & ~bit );
  1203. }
  1204.